MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 06 - 1990/06.12 Dec 90/Simulation code/SimulationToolbox.m

Modula Implementation | 1989-06-18 | 15.6 KB | 619 lines | [TEXT/MPS ]

(****************************************************)
(*                                                    *)
(*    file:  SimulationToolbox.m                        *)
(*                                                    *)
(*  This is the implementation module - see the     *)
(*    definition module for documentation on external    *)
(*    routines.                                        *)
(*                                                    *)
(*    Written in SemperSoft Modula-2 v.1.1.2            *)
(*                                                    *)
(*  Allen Stenger    June 1989                        *)
(*                                                    *)
(****************************************************)

IMPLEMENTATION MODULE SimulationToolbox;

FROM SYSTEM        IMPORT    ADDRESS,ADR,PROCESS,NEWPROCESS,
                        LONG,TRANSFER,TSIZE;
FROM InOut        IMPORT    CloseOutput,OpenOutput;
FROM InOut        IMPORT    Read,WriteCard,WriteLn,
                        WriteString;
FROM Storage    IMPORT    ALLOCATE;
FROM InsideMac    IMPORT    DefltStack,GetApplLimit,
                        SetApplLimit;
FROM VolumeIV    IMPORT    StackSpace;

TYPE
    SimulationQueue    =    POINTER TO QueueBlock;

VAR
    currentTime    :    Duration;
                        (* current simulated time *)

PROCEDURE PrintHalt; FORWARD;

    (************************************************)
    (*                                                *)
    (*    This local module encapsulates the             *)
    (*    workspace allocation and deallocation.        *)
    (*                                                *)
    (************************************************)

    MODULE WorkSpaceManager;
    IMPORT WriteString;
    IMPORT PrintHalt;
    EXPORT    AllocateWorkSpace,DeallocateWorkSpace;

    (******* temporary implementation with all
        fixed-size WS of 8192 bytes *)
    TYPE
        WSIndex        =    [1..15];
        WS            =    ARRAY [1..4096] OF INTEGER;
        WSDesc        =    RECORD
                            WSArea    :    WS;
                            ThisWS,
                            NextWS    :    CARDINAL;
                        END; (* RECORD *)

    VAR
        theWorks    :    ARRAY WSIndex OF WSDesc;
        freeWS        :    CARDINAL;
                            (* chain of free blocks *)

    PROCEDURE AllocateWorkSpace( VAR wsp : ADDRESS;
                                 worksize : CARDINAL );
    BEGIN
        IF worksize # TSIZE(WS)
        THEN
            WriteString(">>>wrong size worksize");
            PrintHalt;
        ELSIF freeWS = 0 THEN
            WriteString(">>> Out of workspaces ");
            PrintHalt;
        ELSE
            WITH theWorks[freeWS] DO
                wsp := ADR(WSArea);
                freeWS := NextWS;
            END; (* WITH *)
        END; (* IF *)
    END AllocateWorkSpace;

    PROCEDURE DeallocateWorkSpace( wsp : ADDRESS;
                                  worksize : CARDINAL );
    VAR
        i    :    CARDINAL;
    BEGIN
        FOR i := MIN(WSIndex) TO MAX(WSIndex) DO
            WITH theWorks[i] DO
                IF ADR(WSArea) = wsp
                THEN
                    NextWS := freeWS;
                    freeWS := i;
                END; (* IF *)
            END; (* WITH *)
        END; (* DO *)
    END DeallocateWorkSpace;

    PROCEDURE Init;
    VAR
        i    :    CARDINAL;
    BEGIN
        (* Chain the workspaces together *)
        freeWS := MIN(WSIndex);
        FOR i := MIN(WSIndex) TO MAX(WSIndex) DO
            WITH theWorks[i] DO
                ThisWS := i;
                NextWS := i + 1;
            END; (* WITH *)
        END; (* FOR *)
        theWorks[MAX(WSIndex)].NextWS := 0;
    END Init;

    BEGIN
        Init;
    END WorkSpaceManager;

    (************************************************)
    (*                                                *)
    (*    This local module encapsulates the TCB         *)
    (*    (Thread Control Block) and does most of the *)
    (*    work of the Toolbox.  References to TCBs     *)
    (*    should pass the TCB (pointer) to this         *)
    (*    package, and should not    reference TCB         *)
    (*    fields directly.                            *)
    (*                                                *)
    (************************************************)

    MODULE TCBManager;
    IMPORT    Duration,Starter;
    IMPORT     WriteString;
    IMPORT    currentTime;
    IMPORT    DeallocateWorkSpace;
    IMPORT     PrintHalt;
    EXPORT     TCB,TCBQHdr,
            DispatchFromQueue,AddToReadyQueue,
            CreateNewTCB,HangHalt,HangHold,StartTCB,
            QueueTCB,DequeueTCB;

    TYPE
        TCBPtr        =    POINTER TO TCBType;
        TCBType        =
        RECORD
            NextTCB        :    TCBPtr;    (* forward chain *)
            ThreadNumber:    CARDINAL; (* seq. no. *)
            HaltPending    :    BOOLEAN;
                                (* halt in progress *)
            SuspendPending : BOOLEAN;
                                (* suspend in progress*)
            ActTime        :    Duration;
                                (* when to activate *)
            State        :    PROCESS; (* from TRANSFER *)
            StartProc    :    Starter; (* where to begin*)
            Parms        :    ADDRESS; (* thread parms *)
            WorkSpace    :    ADDRESS; (* stack address *)
            WorkSize    :    CARDINAL;
                                (* stack size in bytes*)
        END; (* RECORD *)

        TCB            =    TCBPtr;
                        (* for export only - in this
                            module use TCBPtr *)
        TCBQHdr        =    TCBPtr;
        TCBRange    =    [1..20];

    VAR
        (*  TCB lists -- TCBs may also be queued on
            SimulationQueue types *)
        currentTCB    : TCBPtr; (* currently active TCB *)
        readyList    : TCBPtr; (* waiting TCBs,
                        in ascending order of ActTime *)
        haltList    : TCBPtr; (* TCBs awaiting halt *)
        freeTCB        : TCBPtr; (* free list of
                                    TCB blocks *)

        lastThreadNumber : CARDINAL;
                        (* latest
                            TCBPtr^.ThreadNumber *)
        TCBBlocks    : ARRAY TCBRange OF TCBType;
                     (* TCB pool *)

    (*  Dispatch the next TCB from the ready list while
        queueing the current TCB. *)
    PROCEDURE DispatchFromQueue;
    (*
        This is the "scheduler" for the simulation.
        When it is called by a thread, in general that
        thread will be suspended and another will begin
        running.  More precisely, there are 5
        possibilities for the calling thread:
            1.    The thread will return after advancing
                currentTime, without disturbing the
                ready list.  (Only occurs if the current
                TCB has an earlier activation time that
                any TCB on the list.)
            2.    The thread is marked to terminate and
                will dequeue the next TCB from the ready
                list, place it as the current TCB,
                advance currentTime, place itself on the
                halt queue, and suspend itself (by
                TRANSFER to the new current TCB).
            3.    Same as 2 except it places itself in
                order on the ready list.
            4.    The simulation halts because the current
                thread is marked to suspend or terminate
                and there are no ready TCBs.
            5.    Same as 2 except the current TCB has
                already been placed    on a SimulationQueue
                and will not be further touched, except
                to TRANSFER to the next TCB.

        When a new thread is selected to be the current
        thread, there are two possibilities for it:
            A.    It may begin execution at StartTCB (if
                this is its first execution).
            B.    It may begin execution immediately
                following the TRANSFER (if it is
                resuming execution).
        In case B the thread will check the halt queue
        and release any TCBs on it, then will issue
        RETURN, causing it to return to the call that
        send it to the scheduler in the first place.
        Thus for HOLD the thread has held for the
        desired time and is now returning to the
        simulation code, and for suspensions execution
        will resume at the point of suspension.
    *)

    VAR
        saveCurrent        :    TCBPtr;

        PROCEDURE RequeueTCB( t : TCBPtr );
        VAR
            lastTCB,
            thisTCB            :    TCBPtr;
        BEGIN
            lastTCB := NIL;
            thisTCB := readyList;
            WHILE (thisTCB # NIL)
                AND (t^.ActTime >= thisTCB^.ActTime) DO
                lastTCB := thisTCB;
                thisTCB := thisTCB^.NextTCB;
            END; (* WHILE *)
            t^.NextTCB := thisTCB;
            IF lastTCB = NIL
            THEN (* inserting at beginning *)
                readyList := t;
            ELSE (* inserting past beginning *)
                lastTCB^.NextTCB := t;
            END; (* IF *)
        END RequeueTCB;

        PROCEDURE ClearHaltQueue;
        VAR
            releasedTCB        :    TCBPtr;
        BEGIN
            WHILE haltList # NIL DO
                WITH haltList^ DO
                    IF WorkSpace # NIL (* main is
                                        special - no
                                        workspace *)
                    THEN
                        DeallocateWorkSpace(
                            WorkSpace,WorkSize);
                    END; (* IF *)
                END; (* WITH *)
                releasedTCB := haltList;
                haltList := haltList^.NextTCB;
                releasedTCB^.NextTCB := freeTCB;
                freeTCB := releasedTCB;
            END; (* WHILE *)
        END ClearHaltQueue;

    BEGIN (* DispatchFromQueue *)
        IF readyList = NIL
        THEN (* no other active threads *)
            IF currentTCB^.SuspendPending
                OR currentTCB^.HaltPending
            THEN (* case 4 *)
                PrintHalt;
            ELSE (* case 1 with empty ready list *)
                currentTime := currentTCB^.ActTime;
                (* just return *)
            END; (* IF *)
        ELSE (* other active threads -
                see who gets to run *)
            IF     currentTCB^.SuspendPending
                OR currentTCB^.HaltPending
                OR (currentTCB^.ActTime >=
                    readyList^.ActTime)
                    (* >= ensures that list will be
                    shuffled if other TCBs have the
                    same activation time as currentTCB -
                    needed for CreateNewThread *)
            THEN (* new thread gets to run -
                    cases 5, 2 and 3 *)
                saveCurrent := currentTCB;
                currentTCB := readyList;
                readyList := readyList^.NextTCB;
                currentTime := currentTCB^.ActTime;

                IF saveCurrent^.SuspendPending
                THEN (* no queueing action required -
                        case 5 *)
                    saveCurrent^.SuspendPending :=
                        FALSE;
                ELSIF saveCurrent^.HaltPending
                THEN (* put on halt queue - case 2 *)
                    saveCurrent^.NextTCB := haltList;
                    haltList := saveCurrent;
                ELSE (* put on ready list - case 3 *)
                    RequeueTCB(saveCurrent);
                END; (* IF *)

                (*****************************)
                TRANSFER(    saveCurrent^.State,
                            currentTCB^.State);
                (*****************************)

                (* new thread is now in control *)

                ClearHaltQueue;

            ELSE (* old thread continues -
                    case 1 with non-empty ready list*)
                currentTime := currentTCB^.ActTime;
                (* just return *)
            END; (* IF *)
        END; (* IF *)
    END DispatchFromQueue;

    (*    Add a TCB to the beginning of the ready list *)
    PROCEDURE AddToReadyQueue( t : TCBPtr );
    BEGIN
        t^.ActTime := currentTime;
        t^.NextTCB := readyList;
        readyList := t;
    END AddToReadyQueue;

    (*    Allocate a new TCB.  Note that only the pointer
        is returned - the caller has no direct access
        to TCBs but should go through this module.  The
        workspace address and size are recorded in the
        TCB for use when the TCB exits.  *)
    PROCEDURE CreateNewTCB (     VAR t : TCBPtr;
                                p : PROCESS;
                                startP : Starter;
                                parms : ADDRESS;
                                workspace : ADDRESS;
                                worksize : CARDINAL );
    BEGIN
        IF freeTCB = NIL
        THEN
            WriteString(">>>Out of TCBs");
            PrintHalt;
        ELSE
            t := freeTCB;
            freeTCB := freeTCB^.NextTCB;
            WITH t^ DO
                NextTCB := NIL;
                INC(lastThreadNumber);
                ThreadNumber := lastThreadNumber;
                HaltPending := FALSE;
                SuspendPending := FALSE;
                ActTime    := currentTime;
                State := p;
                StartProc := startP;
                Parms := parms;
                WorkSpace := workspace;
                WorkSize := worksize;
            END; (* WITH *)
        END; (* IF *)
    END CreateNewTCB;

    (*  Mark the current TCB to be halted.  It will
        continue to run until DispatchFromQueue is
        called next, at which point the TCB will be
        placed on the halt queue. *)
    PROCEDURE HangHalt;
    BEGIN
        currentTCB^.HaltPending := TRUE;
    END HangHalt;

    (*    Mark the current TCB to run again after a
        specified Duration.  It will continue to run
        until DispatchFrom Queue is called.  *)
    PROCEDURE HangHold ( howLong : Duration );
    BEGIN
        currentTCB^.ActTime := currentTime + howLong;
    END HangHold;

    (*  Begin execution of a new thread according to
        starter in TCB.  This is activated as a result
        of the TRANSFER in DispatchFromQueue the first
        time the thread runs.  *)
    PROCEDURE StartTCB;
    BEGIN
        WITH currentTCB^ DO
            StartProc(Parms);
        END; (* WITH *)
    END StartTCB;

    (*     Add the current TCB to a user queue, or remove
        a TCB from a user queue.  A parameter block
        address is recorded, then returned when the TCB
        is dequeued. *)

    PROCEDURE QueueTCB( qParm : ADDRESS;
                        VAR qHdr : TCBQHdr );
    VAR
        lastTCB    :    TCB;
    BEGIN
        IF qHdr = NIL
        THEN (* only item in queue *)
            qHdr := currentTCB;
        ELSE (* add after last element in queue *)
            lastTCB := qHdr;
            WHILE lastTCB^.NextTCB # NIL DO
                lastTCB := lastTCB^.NextTCB;
            END; (* WHILE *)
            lastTCB^.NextTCB := currentTCB;
        END; (* IF *)
        WITH currentTCB^ DO
            NextTCB := NIL;
            Parms := qParm;
            SuspendPending := TRUE;
        END; (* WITH *)
    END QueueTCB;

    PROCEDURE DequeueTCB(     VAR t : TCB;
                            VAR qParm : ADDRESS;
                            VAR qHdr : TCBQHdr );
    BEGIN
        t := qHdr;
        qHdr := qHdr^.NextTCB;
        qParm := t^.Parms;
    END DequeueTCB;


    PROCEDURE Init;
    VAR
        i            :    CARDINAL; (* loop control *)
        dummyProc    :    Starter; (* just used for main*)
    BEGIN
        readyList := NIL;
        haltList := NIL;
        freeTCB := NIL;

        FOR i := MIN(TCBRange) TO MAX(TCBRange) DO
            TCBBlocks[i].NextTCB := freeTCB;
            freeTCB := ADR(TCBBlocks[i]);
        END; (* FOR *)

        lastThreadNumber := 0;

        (* initialize TCB for already-running
            main routine *)
        CreateNewTCB(currentTCB,PROCESS(0),
                        dummyProc,ADDRESS(0),
                        ADDRESS(0),0);

    END Init;

    BEGIN (* TCBManager *)
        Init;
    END TCBManager;

(****************************************************)
(*                                                    *)
(*    Miscellaneous outer-level routines                *)
(*                                                    *)
(****************************************************)

PROCEDURE PrintHalt;
VAR
    ch    :    CHAR;
BEGIN
    WriteLn;
    WriteLn;
    WriteString(">>> Simulation halting at time ");
    WriteCard( currentTime,6 );
    WriteLn;
    CloseOutput;

    WriteString(">>> Simulation halting at time ");
    WriteCard( currentTime,6 );
    WriteLn;
    WriteString(">>> Press any key to end ");
    Read( ch );
    HALT;
END PrintHalt;

(*  This routine expands the stack after the workspaces
    are allocated to ensure that the Color QuickDraw
    text-drawing routines have enough stack to run. *)
PROCEDURE EnsureEnoughStack;
VAR
    moreThanEnough    :    LONGINT; (* excess over
                                    default *)
BEGIN
    moreThanEnough := StackSpace() - DefltStack;
    IF moreThanEnough < 0
    THEN SetApplLimit(
                GetApplLimit() + moreThanEnough );
    END; (* IF *)
END EnsureEnoughStack;

(****************************************************)
(*                                                    *)
(*    Externally visible routines - see definition     *)
(*    module for documentation.                        *)
(*                                                    *)
(****************************************************)

PROCEDURE CreateNewThread(     starter : Starter;
                            parameterAddress : ADDRESS;
                            worksize : CARDINAL );
VAR
    newTCB            :    TCB;
    wsp                :    ADDRESS;
    threadProcess    :    PROCESS;
BEGIN
    AllocateWorkSpace(wsp, worksize);
    NEWPROCESS(    StartTCB,wsp,LONG(worksize),
                threadProcess);
    CreateNewTCB(newTCB,threadProcess,
                    starter,parameterAddress,wsp,
                    worksize);
    AddToReadyQueue(newTCB);
    DispatchFromQueue;
END CreateNewThread;

PROCEDURE Hold( howLong : Duration );
BEGIN
    HangHold( howLong );
    DispatchFromQueue;
END Hold;

PROCEDURE HaltSimulation;
BEGIN
    PrintHalt;        (* A Quick and Dirty Production *)
END HaltSimulation;

PROCEDURE HaltThread;
BEGIN
    HangHalt;
    DispatchFromQueue;
END HaltThread;

PROCEDURE CurrentTime() : Duration;
BEGIN
    RETURN currentTime;
END CurrentTime;

(****************************************************)
(*    Queueing routines                                *)
(****************************************************)

(* External definitions for queueing *)
TYPE
    QueueBlock    =    RECORD
                        Orders    :    TCBQHdr;
                            (* waiters for service *)
                        Servers    :    TCBQHdr;
                            (* providers of service *)
                    END; (* RECORD *)
    Requester        =    TCB;


PROCEDURE InitializeQueue( VAR q : SimulationQueue );
BEGIN
    NEW( q );
    q^.Orders := NIL;
    q^.Servers := NIL;
END InitializeQueue;

PROCEDURE PlaceOrder(     q : SimulationQueue;
                        parameterAddress : ADDRESS );
VAR
    s        :    TCB; (* server which is activated
                        by this order *)
    trash    :    ADDRESS;
BEGIN
    QueueTCB( parameterAddress, q^.Orders );
    IF q^.Servers = NIL
    THEN (* have to wait *)
    ELSE (* activate server for this queue *)
        DequeueTCB( s, trash, q^.Servers );
        AddToReadyQueue( s );
        (* the server will run and dequeue this order *)
    END; (* IF *)
    DispatchFromQueue;
END PlaceOrder;

PROCEDURE Serve( q: SimulationQueue;
                VAR parameterAddress : ADDRESS;
                VAR r : Requester );
BEGIN
    IF q^.Orders = NIL
    THEN (* have to wait for order *)
        QueueTCB( NIL, q^.Servers );
        DispatchFromQueue; (* wait for order *)
    END; (* IF *)
    (*     either resume execution after order arrives, or
        continue without wait if order already
        available *)
    DequeueTCB( r, parameterAddress, q^.Orders);
END Serve;

PROCEDURE Reactivate( r : Requester );
BEGIN
    AddToReadyQueue( r );
END Reactivate;


BEGIN (* SimulationToolbox *)
    currentTime := 0;
    EnsureEnoughStack;
    OpenOutput("Enter file name for logging:");
END SimulationToolbox.